home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Clinic / MemSizeU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-06  |  1.7 KB  |  75 lines
  1. unit MemSizeU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     Panel1: TPanel;
  13.     Timer1: TTimer;
  14.     Label1: TLabel;
  15.     procedure Button1Click(Sender: TObject);
  16.     procedure Timer1Timer(Sender: TObject);
  17.   private
  18.     { Private declarations }
  19.   public
  20.     { Public declarations }
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.DFM}
  29.  
  30. uses
  31.   PSAPI;
  32.  
  33. procedure TForm1.Button1Click(Sender: TObject);
  34. begin
  35.   with TEdit.Create(Self) do
  36.   begin
  37.     Parent := Panel1;
  38.     Left := Random(Panel1.Width - Width - 1);
  39.     Top := Random(Panel1.Height - Height - 1);
  40.   end;
  41. end;
  42.  
  43. procedure TForm1.Timer1Timer(Sender: TObject);
  44. var
  45.   SI: TSystemInfo;
  46.   PageSize: DWord;
  47.   CurrentProcessHandle: THandle;
  48.   DWords: array[0..2048] of DWord;
  49.   Res: DWord;
  50. const
  51.   KiloByte = 1024;
  52. begin
  53.   GetSystemInfo(SI);
  54.   PageSize := SI.dwPageSize div KiloByte;
  55.   CurrentProcessHandle := OpenProcess(
  56.     PROCESS_QUERY_INFORMATION, False, GetCurrentProcessId);
  57.   //Working set only valid on NT
  58.   if Win32Platform = VER_PLATFORM_WIN32_NT then
  59.     if QueryWorkingSet(CurrentProcessHandle, @DWords, SizeOf(DWords)) then
  60.       Label1.Caption :=
  61.         Format('Working set = %d kb', [DWords[0] * PageSize])
  62.     else
  63.     begin
  64.       //If QueryWorkingSet fails, show error no./msg.
  65.       Res := GetLastError;
  66.       Label1.Caption :=
  67.         Format('Cannot calculate working set, Win32 error %d (%s)',
  68.           [Res, SysErrorMessage(Res)])
  69.     end
  70.   else
  71.     Label1.Caption := 'Working set only valid on NT platforms'
  72. end;
  73.  
  74. end.
  75.